home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: delta
/
whiteline CD Series - delta.iso
/
progtool
/
modula2
/
module
/
easydial.mod
< prev
next >
Wrap
Text File
|
1995-11-25
|
19KB
|
571 lines
IMPLEMENTATION MODULE EasyDialog;
(* Version*: 20.12.89 00:21*)
FROM SYSTEM IMPORT ADR,SHIFT,ADDRESS,VAL,WORD,TSIZE;
FROM AES IMPORT WindowUpdate, GrafMouseKeyboardState,FileSelectorInput,
FormCenter,FormDialogue,ObjectDraw,FormDo,ObjectChange,
GrafMouse,WindowGet,GrafDragBox,
ObjectFind,EventMultiple,ObjectEdit;
FROM GEMDOS IMPORT GetDrv,GetPath,ConOut;
FROM XBIOS104 IMPORT KeyTable,SetKeyTable, KeyTablePtr,KeyTrans,KeyTransPtr;
FROM CookieJar IMPORT Cookie,GetCookie,CreateCookie;
FROM Strings IMPORT Concat,Length,DeleteChar;
FROM BitBlt IMPORT CopyMemToScreen,CopyScreenToMem;
FROM GEMAESbase IMPORT Normal,MouseOff,MouseOn,
Editable,FlatHand,Arrow,GraphicButton,Default,
BeginUpdate,EndUpdate,Selectable,Black,White,
KeyboardEvent,ButtonEvent,BitBlk,Crossed,Checked,
FormStart,FormGrow,FormShrink,FormFinish,
Object,TEdInfo,Selected,GemCall,
IntIn2,IntIn3,
AESGlobal,AESAddrIn,AESIntOut,AESIntIn;
VAR SizeOfObject:INTEGER;
DX,DY,DW,DH :INTEGER;
buf :ADDRESS;
MouseX,MouseY :INTEGER;
ch :CHAR;
ButtonIndex :INTEGER;
DefaultObject :INTEGER;
PROCEDURE GetObjectPointer( TreePtr:ADDRESS; Index :INTEGER ) : ADDRESS;
BEGIN
RETURN TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
END GetObjectPointer;
PROCEDURE GetObjectTail( TreePtr:ADDRESS; Index :INTEGER ) : INTEGER;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN Probe^.tail;
END GetObjectTail;
PROCEDURE GetObjectHead( TreePtr:ADDRESS; Index :INTEGER ) : INTEGER;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN Probe^.head;
END GetObjectHead;
PROCEDURE GetObjectType( TreePtr:ADDRESS; Index :INTEGER ) : INTEGER;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN Probe^.type;
END GetObjectType;
PROCEDURE GetObjectState( TreePtr:ADDRESS; Index :INTEGER ) : INTEGER;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN Probe^.state;
END GetObjectState;
PROCEDURE GetNextObject( TreePtr:ADDRESS; Index :INTEGER ) : INTEGER;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN Probe^.next;
END GetNextObject;
PROCEDURE GetObjectFlags(Index:INTEGER; TreePtr:ADDRESS ) : INTEGER;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN Probe^.flags;
END GetObjectFlags;
PROCEDURE SetObjectFlags(Index:INTEGER; TreePtr:ADDRESS; NewFlag:INTEGER );
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
Probe^.flags:=NewFlag;
END SetObjectFlags;
PROCEDURE GetObjectXYWH(Index:INTEGER; TreePtr:ADDRESS;VAR x,y,w,h:CARDINAL);
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
x:= Probe^.x;
y:= Probe^.y;
w:= Probe^.width;
h:= Probe^.height;
END GetObjectXYWH;
PROCEDURE SetObjectXYWH(Index:INTEGER; TreePtr:ADDRESS;x,y,w,h:CARDINAL );
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
Probe^.x:=x;
Probe^.y:=y;
Probe^.width:=w;
Probe^.height:=h;
END SetObjectXYWH;
PROCEDURE GetText(Index:INTEGER;TreePtr:ADDRESS; VAR String: ARRAY OF CHAR );
VAR StringAdr :POINTER TO TEdInfo;
Probe :POINTER TO Object;
Str :POINTER TO ARRAY[0..63] OF CHAR;
i:INTEGER;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
StringAdr:=(Probe^.spec);
Str:=StringAdr^.ptext;
FOR i:=0 TO HIGH(String) DO
String[i]:= Str^[i];
END(*FOR*);
END GetText;
PROCEDURE SetText(Index:INTEGER;TreePtr:ADDRESS; String: ARRAY OF CHAR );
VAR StringAdr :POINTER TO TEdInfo;
Probe :POINTER TO Object;
Str :POINTER TO ARRAY[0..63] OF CHAR;
i:INTEGER;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
StringAdr:=(Probe^.spec);
Str:=StringAdr^.ptext;
FOR i:=0 TO HIGH(String) DO
Str^[i]:=String[i];
END(*FOR*);
END SetText;
PROCEDURE GetBoxColor(Index:INTEGER;TreePtr:ADDRESS):INTEGER;
TYPE
adr2bs = RECORD CASE : BOOLEAN OF
TRUE : a : ADDRESS;
|FALSE: h,l : BITSET;
END(*CASE*);
END(*RECORD*);
VAR bs : adr2bs;
Probe :POINTER TO Object;
i:INTEGER;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
(* Im letzten Nibble ist die Farbe kodiert von 0-F);*)
bs.a:=Probe^.spec;
i:=VAL(INTEGER,(bs.l * {0..3}));
RETURN i
END GetBoxColor;
PROCEDURE SetBoxColor(Index:INTEGER;TreePtr:ADDRESS;Colour :INTEGER);
TYPE
adr2bs = RECORD CASE : BOOLEAN OF
TRUE : a : ADDRESS;
|FALSE: h,l : BITSET;
END(*CASE*);
END(*RECORD*);
VAR bs : adr2bs;
Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
bs.a:=Probe^.spec;
bs.l:=bs.l * {4..15};
bs.l:=bs.l + VAL(BITSET,Colour);
Probe^.spec:=bs.a
END SetBoxColor;
PROCEDURE WorkTree(TreePtr :ADDRESS; StartObject,EndObject :INTEGER;
Do: TreePROC);
VAR
ObjectIndex,
Head, Tail :INTEGER;
BEGIN
ObjectIndex:=StartObject;
REPEAT
Do(TreePtr,ObjectIndex);
Head:= GetObjectHead(TreePtr,ObjectIndex);
Tail:= GetObjectTail(TreePtr,ObjectIndex);
IF Head # -1 THEN
WorkTree(TreePtr,Head,Tail,Do);
END(*IF*);
IF ObjectIndex # EndObject THEN
ObjectIndex:=GetNextObject(TreePtr,ObjectIndex);
ELSE
ObjectIndex:=-1;
END(*IF*);
UNTIL ObjectIndex=(-1)
END WorkTree;
PROCEDURE FormButton(Tree :ADDRESS; Object,Clicks : INTEGER;
VAR NextObject :INTEGER):INTEGER;
VAR ExButton : INTEGER;
BEGIN
AESAddrIn[0]:=Tree;
IntIn2(Object,Clicks);
ExButton:=GemCall(56,2,2,1,0);
NextObject:=AESIntOut[1];
RETURN AESIntOut[0]
END FormButton;
PROCEDURE FormKeyboard(Tree :ADDRESS; Object,Next,Char:INTEGER;
VAR NextObject,NextChar :INTEGER):INTEGER;
VAR ExButton : INTEGER;
BEGIN
AESAddrIn[0]:=Tree;
IntIn3(Object,Char,Next);
ExButton:=GemCall(55,3,3,1,0);
NextObject:=AESIntOut[1];
NextChar:=AESIntOut[2];
RETURN AESIntOut[0]
END FormKeyboard;
PROCEDURE and(a,b:WORD):BOOLEAN;
VAR c: BITSET;
BEGIN
c:=VAL(BITSET,a)*VAL(BITSET,b);
IF c<>VAL(BITSET,0) THEN RETURN TRUE
ELSE RETURN FALSE;
END(*IF*);
END and;
PROCEDURE SelectCheckBox(TreePtr :ADDRESS; Index : INTEGER);
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
IF (GetBoxColor(Index,TreePtr)=Black) AND (Probe^.state=Crossed) THEN
Probe^.state:=Probe^.state+Selected;
ELSIF (GetBoxColor(Index,TreePtr)=Black) AND (Probe^.state=Checked) THEN
Probe^.state:=Probe^.state+Selected;
END(*IF*);
END SelectCheckBox;
PROCEDURE InitCheckBoxes(TreePtr : ADDRESS);
VAR SelectBoxes : TreePROC;
BEGIN
SelectBoxes:=SelectCheckBox;
WorkTree(TreePtr,0,0,SelectBoxes);
END InitCheckBoxes;
PROCEDURE FindLastButtonCapChar(TreePtr :ADDRESS; Index :INTEGER);
VAR Probe : POINTER TO Object;
s : POINTER TO ARRAY [0..40] OF CHAR;
j : INTEGER;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
IF (Probe^.type = GraphicButton)
AND and(Probe^.flags,Selectable) THEN
s:=Probe^.spec;
j:=-1;
REPEAT
j:= j+1
UNTIL (s^[j]=0C) OR (s^[j]=ch);
IF s^[j]#0C THEN
ButtonIndex:=Index;
END(*IF*);
END(*IF*);
END FindLastButtonCapChar;
PROCEDURE FindDefault(TreePtr:ADDRESS; Index:INTEGER);
VAR DiaObject : POINTER TO Object;
BEGIN
DiaObject:=TreePtr+ VAL(ADDRESS,(Index*SizeOfObject));
IF and(DiaObject^.flags,Default) THEN
DefaultObject:=Index;
END(*IF*);
END FindDefault;
PROCEDURE MoveDial(ID:INTEGER;TreePtr:ADDRESS);
VAR x,y,w,h :CARDINAL;
deskx,desky,deskw,deskh,
xF,yF,formret :INTEGER;
String : ARRAY [0..127] OF CHAR;
BEGIN
GetObjectXYWH(ID,TreePtr,x,y,w,h);
GrafMouse(FlatHand,NIL);
WindowGet(0,4,deskx,desky,deskw,deskh);
(* Dialogbox darf nicht ausserhalb des Bildschirms sein!!*)
GrafDragBox (w,h,x,y,deskx+3,desky+3, deskw-6, deskh-6,xF,yF);
SetObjectXYWH(ID,TreePtr,xF,yF,w,h);
GrafMouse(Arrow,NIL);
END MoveDial;
PROCEDURE MoveFormDo(TreePtr :ADDRESS; EditObject :INTEGER):INTEGER;
CONST
ROOT =0;
MAXDEPTH=8;
EDINIT=1;
EDCHAR=2;
EDEND=3;
VAR pKeyTable :KeyTablePtr;
pKeyTa, KbdShift: KeyTransPtr;
VAR x,y,w,h :CARDINAL;
i,j,obj,mx,my,pos,button,cli,leave,event :INTEGER;
msg : ARRAY [0..7] OF INTEGER;
SpKey,key,NewPos : INTEGER;
specstr,buffer : ADDRESS;
SeekButton : TreePROC;
IsDefault : TreePROC;
BEGIN
DefaultObject:=-1;
IsDefault:=FindDefault;
WorkTree(TreePtr,0,0,IsDefault);
pKeyTa:=VAL(ADDRESS,-1);
pKeyTable:=SetKeyTable( pKeyTa, pKeyTa, pKeyTa);
KbdShift:=pKeyTable^.shift;
SeekButton:= FindLastButtonCapChar;
leave :=1;
GetObjectXYWH(ROOT,TreePtr,x,y,w,h);
GrafMouse(MouseOff,NIL);
CopyScreenToMem(x-2,y-2,w+5,h+5,buffer);
ObjectDraw(TreePtr,0,6,x-2,y-2,w+4,h+4);
GrafMouse(MouseOn,NIL);
IF EditObject>0 THEN
ObjectEdit(TreePtr,EditObject,0,pos,EDINIT,NewPos);
(* Cursor einschalten *)
END(*IF*);
WHILE leave>0 DO
event := EventMultiple(KeyboardEvent+ButtonEvent,2,1,1,
0,0,0,0,0,0,0,0,0,0,
ADR(msg),0,0,
mx,my,button,SpKey,key,cli);
pos := NewPos;
IF and(event,ButtonEvent) THEN
obj:=ObjectFind(TreePtr,ROOT,MAXDEPTH,mx,my);
IF obj >0 THEN
(* Ist es eine Checkbox ? *)
IF (GetObjectFlags(obj,TreePtr)=Selectable) AND
(GetObjectState(TreePtr,obj)=Checked+Selected) AND
(GetBoxColor(obj,TreePtr)=Black) THEN
ObjectChange(TreePtr,obj,0,x,y,w,h,Crossed+Selected,1);
ELSIF (GetObjectFlags(obj,TreePtr)=Selectable) AND
(GetObjectState(TreePtr,obj)=Crossed+Selected) AND
(GetBoxColor(obj,TreePtr)=Black) THEN
ObjectChange(TreePtr,obj,0,x,y,w,h, Checked+Selected,1);
(* Bei Editierbaren Feldern Cursor wechseln *)
ELSIF and(GetObjectFlags(obj,TreePtr),Editable) AND (obj#EditObject) THEN
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
EditObject:=obj;
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
ELSE
leave := FormButton(TreePtr,obj,cli,obj);
END(*IF*);
ELSIF obj=0 THEN
(* Move *)
IF (EditObject>0) THEN
(* Cursor ausschalten falls es Edit-Felder gab *)
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
END(*IF*);
MoveDial(ROOT,TreePtr);
(* Bildschirm restaurieren *)
GrafMouse(MouseOff,NIL);
(* Bildschirm restaurieren an alter Dialogposition*)
CopyMemToScreen(x-2,y-2,w+5,h+5,buffer,TRUE);
(* Neue Dialogkoordinaten holen *)
GetObjectXYWH(ROOT,TreePtr,x,y,w,h);
(* Bildschirmhintergrund an neuer Dialogposition retten *)
CopyScreenToMem(x-2,y-2,w+5,h+5,buffer);
(* Dialog neuzeichnen *)
ObjectDraw(TreePtr,0,8,x-2,y-2,w+4,h+4);
IF (EditObject>0) THEN
(* Cursor wieder einschalten falls es Edit-Felder gab *)
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
END(*IF*);
GrafMouse(MouseOn,NIL);
ELSE
(*Glocke*)
ConOut(7C);
END(*IF*);
ELSIF and(event,KeyboardEvent) THEN
IF SpKey=08H THEN (* Alternate wurde gedrückt *)
ch:=CHR(VAL(INTEGER,KbdShift^[SHIFT(key,-8)]));
ButtonIndex:=-1;
WorkTree(TreePtr,0,0,SeekButton);
IF ButtonIndex #-1 THEN
(* Eintrag gefunden !! *)
leave := FormButton(TreePtr,ButtonIndex,1,obj);
END(*IF*);
ELSE
(* Return gedrückt und kein DEFAULT-Object? *)
IF (DefaultObject=-1) AND ((key =7181(*RETURN*))
OR (key=29197(*ENTER*))) THEN
(* In TAB-Taste umsetzen *)
key := 3849;(* TAB *)
END(*IF*);
leave:=FormKeyboard(TreePtr,EditObject,0,key,obj,SpKey);
IF SpKey >0 THEN
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDCHAR,NewPos);
ELSE
IF and(GetObjectFlags(obj,TreePtr),Editable) AND (obj#EditObject)
AND (obj<=GetObjectTail(TreePtr,ROOT)) THEN
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
EditObject:=obj;
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
END(*IF*);
END(*IF*);
END(*IF*);
END(*IF*);
END(*WHILE*);
IF (EditObject>0) THEN
(* Cursor wieder ausschalten falls es Edit-Felder gab *)
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
END(*IF*);
GrafMouse(MouseOff,NIL);
(* Bildschirmhintergrund wiederherstellen *)
CopyMemToScreen(x-2,y-2,w+5,h+5,buffer,TRUE);
GrafMouse(MouseOn,NIL);
RETURN obj
END MoveFormDo;
PROCEDURE FileSelectXtendedInput(VAR InPath,InSelect:ARRAY OF CHAR;
VAR ExButton:INTEGER; label: ARRAY OF CHAR):INTEGER;
BEGIN
AESAddrIn[0]:=ADR(InPath);
AESAddrIn[1]:=ADR(InSelect);
AESAddrIn[2]:=ADR(label);
ExButton:=GemCall(91,3,2,3,1);
ExButton:=AESIntOut[1];
RETURN AESIntIn[1]
END FileSelectXtendedInput;
PROCEDURE EasyFileSelect(VAR Maske, DateiName:ARRAY OF CHAR; Text : ARRAY OF CHAR):BOOLEAN;
VAR
OK : BOOLEAN;
ret : INTEGER;
ExButton : INTEGER;
Drive,i : CARDINAL;
DrvName : ARRAY[0..2] OF CHAR;
PathName : ARRAY[0..127] OF CHAR;
fsel : Cookie;
BEGIN
CreateCookie(fsel,'FSEL',0D);
GetDrv(Drive);
DrvName[0]:=CHR(65+Drive);DrvName[1]:=':';
DrvName[2]:=0C;
GetPath(PathName,0);
Concat(DrvName,PathName,PathName,OK);
DrvName:='\';
Concat(PathName,DrvName,PathName,OK);
Concat(PathName,Maske,Maske,OK);
IF (AESGlobal.apVersion >= 140H) OR (GetCookie(fsel)) THEN
(* FselXInput *)
ret:=FileSelectXtendedInput(Maske,DateiName,ExButton,Text);
ELSE
(* Normale FselInput *)
FileSelectorInput(ADR(Maske),ADR(DateiName),ExButton);
END(*IF*);
REPEAT
i:=Length(Maske);
DeleteChar(Maske,i);
UNTIL Maske[i-2]='\';
RETURN ExButton=1;
END EasyFileSelect;
PROCEDURE IsSelected(Index:INTEGER; TreePtr:ADDRESS ) : BOOLEAN;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN and(Probe^.state,Selected);
END IsSelected;
PROCEDURE IsCrossed(Index:INTEGER; TreePtr:ADDRESS ) : BOOLEAN;
VAR Probe :POINTER TO Object;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObject));
RETURN and(Probe^.state,Crossed);
END IsCrossed;
PROCEDURE DrawDialog(DialogAdresse:ADDRESS);
VAR KeyState,MouseState:INTEGER;
BEGIN
WindowUpdate(BeginUpdate);
WindowUpdate(BeginMouseControl);
FormCenter(DialogAdresse,DX,DY,DW,DH);
GrafMouseKeyboardState(MouseX,MouseY,KeyState,MouseState);
GrafMouse(MouseOff,NIL);
CopyScreenToMem(DX,DY,DW,DH,buf);
IF buf=NIL THEN
FormDialogue(FormStart,MouseX,MouseY,10,10,DX,DY,DW,DH);
END(*IF*);
FormDialogue(FormGrow,MouseX,MouseY,10,10,DX,DY,DW,DH);
ObjectDraw(DialogAdresse,0,6,DX,DY,DW,DH);
GrafMouse(MouseOn,NIL);
END DrawDialog;
PROCEDURE UndrawDialog(DialogAdresse : ADDRESS);
BEGIN
FormDialogue(FormShrink,MouseX,MouseY,10,10,DX,DY,DW,DH);
GrafMouse(MouseOff,NIL);
IF buf=NIL THEN
FormDialogue(FormFinish,MouseX,MouseY,10,10,DX,DY,DW,DH);
ELSE
CopyMemToScreen(DX,DY,DW,DH,buf,TRUE);
END(*IF*);
GrafMouse(MouseOn,NIL);
WindowUpdate(EndMouseControl);
WindowUpdate(EndUpdate);
END UndrawDialog;
PROCEDURE DoDialog(DialogAdresse:ADDRESS;ErstesObject:INTEGER):INTEGER;
VAR Probe :POINTER TO Object;
DiaRETURN :INTEGER;
BEGIN
DrawDialog(DialogAdresse);
DiaRETURN:= FormDo(DialogAdresse,ErstesObject);
Probe:=DialogAdresse+VAL(ADDRESS, (DiaRETURN *SizeOfObject));
IF and(Probe^.state,Selected) THEN
ObjectChange(DialogAdresse,DiaRETURN,0,DX,DY,DW,DH,Probe^.state-Selected,0);
END(*IF*);
UndrawDialog(DialogAdresse );
RETURN DiaRETURN;
END DoDialog;
PROCEDURE DoMoveDialog(DialogAdresse:ADDRESS;ErstesObject:INTEGER):INTEGER;
VAR Probe :POINTER TO Object;
DiaRETURN :INTEGER;
BEGIN
WindowUpdate(BeginUpdate);
WindowUpdate(BeginMouseControl);
FormCenter(DialogAdresse,DX,DY,DW,DH);
InitCheckBoxes(DialogAdresse);
DiaRETURN:= MoveFormDo(DialogAdresse,ErstesObject);
Probe:=DialogAdresse+VAL(ADDRESS, (DiaRETURN *SizeOfObject));
IF and(Probe^.state,Selected) THEN
ObjectChange(DialogAdresse,DiaRETURN,0,DX,DY,DW,DH,Probe^.state-Selected,0);
END(*IF*);
WindowUpdate(EndMouseControl);
WindowUpdate(EndUpdate);
RETURN DiaRETURN;
END DoMoveDialog;
BEGIN
SizeOfObject:=TSIZE(Object);
END EasyDialog.